home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / PACK.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  14KB  |  440 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* pack.c: translation of pack.stl */
  10.  
  11. #define GEN
  12.  
  13. #include "hdr.h"
  14. #include "libhdr.h"
  15. #include "vars.h"
  16. #include "segment.h"
  17. #include "gvars.h"
  18. #include "ops.h"
  19. #include "type.h"
  20. #include "setp.h"
  21. #include "statp.h"
  22. #include "procp.h"
  23. #include "miscp.h"
  24. #include "maincasp.h"
  25. #include "genp.h"
  26. #include "gutilp.h"
  27. #include "gmiscp.h"
  28. #include "libp.h"
  29. #include "segmentp.h"
  30. #include "smiscp.h"
  31. #include "packp.h"
  32.  
  33. #ifdef MONITOR
  34. extern char MON_PACKAGE_NAME[33];
  35. #endif
  36.  
  37. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  38.  
  39.  
  40. /*
  41.  * Chapter 7: Packages
  42.  *  The only problem with packages is the possible presence of tasks
  43.  *  objects in the specification part and the point of their activation
  44.  *  as defined by the RM: on the 'begin' of the package body, if it
  45.  *  exists.
  46.  */
  47.  
  48. void gen_package(Node pack_node)                            /*;gen_package*/
  49. {
  50.     Tuple    tup;
  51.     Node    id_node, decl_node, private_node;
  52.     int     save_tasks_declared;
  53.     Tuple    save_subprog_specs;
  54.     Symbol    package_name;
  55.  
  56.     save_tasks_declared = TASKS_DECLARED;
  57.     TASKS_DECLARED      = FALSE;
  58.     save_subprog_specs  = SUBPROG_SPECS;
  59.     SUBPROG_SPECS       = tup_new(0);
  60.  
  61. #ifdef TRACE
  62.     if (debug_flag)
  63.         gen_trace_node("GEN_PACKAGE", pack_node);
  64. #endif
  65.  
  66.     id_node = N_AST1(pack_node);
  67.     decl_node = N_AST2(pack_node);
  68.     private_node = N_AST3(pack_node);
  69.     package_name = N_UNQ(id_node);
  70.  
  71.     next_local_reference(package_name);
  72.  
  73.     gen_kv(I_PUSH_IMMEDIATE, mu_word, int_const_null_task);
  74.     if (save_tasks_declared) {
  75.         gen_c(I_LINK_TASKS_DECLARED, "save current tasks_declared");
  76.         gen_ks(I_DECLARE, mu_word, package_name);
  77.     }
  78.     else {
  79.         gen_ks(I_DECLARE, mu_word, package_name);
  80.         /* mu_word? */
  81.         gen_ksc(I_POP, mu_word, package_name, "initialize tasks declared");
  82.     }
  83.  
  84.     compile(decl_node);
  85.     compile(private_node);
  86.  
  87.     if (TASKS_DECLARED || save_tasks_declared)
  88.         gen_s(I_POP_TASKS_DECLARED, package_name);
  89.  
  90.     /* needs body already checked by FE */
  91.     tup = tup_new(3);
  92.     tup[1] = (char *) TASKS_DECLARED;
  93.     tup[2] = (char *) 0;
  94.     tup[3] = (char *) tup_copy(SUBPROG_SPECS);
  95.     MISC(package_name) = (char *) tup;
  96.     /* insert warning check in case symbol not package  ds 9-8-85*/
  97.     if (!(NATURE(package_name) == na_package
  98.       || NATURE(package_name)==na_package_spec)) {
  99.         chaos("pack.c: genpack - setting MISC for symbol ");
  100.     }
  101.  
  102.     TASKS_DECLARED = save_tasks_declared;
  103.     SUBPROG_SPECS  = save_subprog_specs;
  104.  
  105. }
  106.  
  107. void gen_package_body(Node body_node)                    /*;gen_package_body*/
  108. {
  109.     /* Process package body that is not a library unit */
  110.  
  111.     Tuple    tup;
  112.     Symbol    package_name;
  113.     int save_tasks_declared;
  114.     Tuple    save_subprog_specs;
  115.     Node    id_node, decl_node, stmts_node, handler_node;
  116.  
  117. #ifdef TRACE
  118.     if (debug_flag)
  119.         gen_trace_node("GEN_PACKAGE_BODY", body_node);
  120. #endif
  121.  
  122.     id_node = N_AST1(body_node);
  123.     decl_node = N_AST2(body_node);
  124.     stmts_node = N_AST3(body_node);
  125.     handler_node = N_AST4(body_node);
  126.     package_name = N_UNQ(id_node);
  127.  
  128.     save_tasks_declared = TASKS_DECLARED;
  129.     tup = (Tuple) MISC(package_name);
  130.     TASKS_DECLARED = (tup != (Tuple)0) ? (int) tup[1] : FALSE;
  131.  
  132.     save_subprog_specs  = SUBPROG_SPECS;
  133.     /* Note that SUBPROG_SPECS now stored in 3rd MISC entry   ds 7-9-85*/
  134.     SUBPROG_SPECS = (tup != (Tuple)0) ? tup_copy((Tuple) tup[3]) : tup_new(0);
  135.  
  136.     /* trivial case: this is a dummy package body and no task declared in */
  137.     /*             the specification part. */
  138.     /*
  139.      *   if blk=[] and not TASKS_DECLARED then
  140.      *    TASKS_DECLARED := save_tasks_declared;
  141.      *    return;
  142.      *   end if;
  143.      */
  144.  
  145.     if (TASKS_DECLARED || save_tasks_declared) {
  146.         gen_ksc(I_PUSH, mu_word, package_name, "retrieve tasks_declared");
  147.         gen(I_LINK_TASKS_DECLARED);
  148.     }
  149.  
  150.     /*
  151.      *   if blk = [] then    $ dummy body, TASKS_DECLARED always TRUE
  152.      *    generate(I_ACTIVATE);
  153.      *   else
  154.      */
  155.     compile(decl_node);
  156.     if (TASKS_DECLARED) {
  157.         gen(I_ACTIVATE);
  158.     }
  159.     else if (save_tasks_declared) {
  160.         gen_sc(I_POP_TASKS_DECLARED, package_name, "discard one level");
  161.     }
  162.  
  163.     compile_body(OPT_NODE, stmts_node, handler_node, TRUE);
  164.     /*   end if; */
  165.  
  166.     TASKS_DECLARED = save_tasks_declared;
  167.     SUBPROG_SPECS  = save_subprog_specs;
  168. }
  169.  
  170. void unit_package_spec(Node pack_node)                    /*;unit_package_spec*/
  171. {
  172.     /*
  173.      * Compilation of a library package spec.
  174.      * As it is a compilation unit, there is no task link to be preserved
  175.      */
  176.  
  177.     Node    id_node, decl_node, private_node;
  178.     Symbol    package_name, package_proc;
  179.     Tuple    tup;
  180.     Tuple    local_reference_map_new();
  181.     Symbol package_tasks;
  182.  
  183. #ifdef TRACE
  184.     if (debug_flag)
  185.         gen_trace_node("UNIT_PACKAGE_SPEC", pack_node);
  186. #endif
  187.  
  188.     id_node = N_AST1(pack_node);
  189.     decl_node = N_AST2(pack_node);
  190.     private_node = N_AST3(pack_node);
  191.     package_name = N_UNQ(id_node);
  192.  
  193.     TASKS_DECLARED = FALSE;
  194.     CURRENT_LEVEL  = 1;
  195.     LAST_OFFSET      = -SFP_SIZE;
  196.     MAX_OFFSET      = 0;
  197.     /* TBSL: see if can free current local reference map before allocating
  198.      * new one    ds 23-may 
  199.      */
  200.     LOCAL_REFERENCE_MAP = local_reference_map_new();
  201.  
  202.     /* Create associated name for initialization proc for spec. */
  203.     /*package_proc           = package_name+'_spec';*/
  204.     package_proc = sym_new(na_procedure);
  205.     assoc_symbol_put(package_name, INIT_SPEC, package_proc);
  206.     new_symbol(package_proc, na_procedure, symbol_none, tup_new(0), (Symbol)0);
  207.     ORIG_NAME(package_proc) = ORIG_NAME(package_name);
  208. #ifdef MONITOR
  209.     strncpy( MON_PACKAGE_NAME, ORIG_NAME(package_name), 32 );
  210. #endif
  211.     generate_object(package_proc);
  212.     CURRENT_DATA_SEGMENT = select_entry(SELECT_DATA, package_proc, SLOTS_DATA);
  213.     CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, package_proc, SLOTS_CODE);
  214. #ifdef MACHINE_CODE
  215.     if (list_code) {
  216.         to_gen_int("       data slot #", CURRENT_DATA_SEGMENT);
  217.         to_gen_int("       code slot #", CURRENT_CODE_SEGMENT);
  218.         to_gen(" ");
  219.     }
  220. #endif
  221.     next_global_reference_r(package_proc, CURRENT_CODE_SEGMENT, 0);
  222.  
  223.     /* Create associated name for initialization of inner tasks.*/
  224.     /*package_tasks        = package_name+'_tasks';*/
  225.     package_tasks = sym_new(na_obj);
  226.     assoc_symbol_put(package_name, INIT_TASKS, package_tasks);
  227.     /* SETL version gives package_tasks signature with null tuple.
  228.     * This does not correspond to usual form of signature
  229.     * for na_obj, namely a node. Hence in C we set it to
  230.     * null pointer.
  231.     */
  232.     new_symbol(package_tasks, na_obj, symbol_none, (Tuple)0, 
  233.       (Symbol)package_tasks);
  234.     generate_object(package_tasks);
  235.     /* TBSL: see if byte is appropriate: 
  236.      * next_global_reference_word(package_tasks, [0]);
  237.      */
  238.     next_global_reference_word(package_tasks, 0);
  239.  
  240.     gen(I_LEAVE_BLOCK);
  241.     gen(I_RAISE);
  242.  
  243.     compile(decl_node);
  244.     compile(private_node);
  245.  
  246.     if (TASKS_DECLARED)
  247.         gen_s(I_POP_TASKS_DECLARED, package_tasks);
  248.     gen(I_ENTER_BLOCK);
  249.     gen(I_LEAVE_BLOCK);
  250.     MAX_OFFSET = offset_max(MAX_OFFSET, LAST_OFFSET);
  251.     /* calculate the size of local objects and don't assume it is zero 
  252.     * because it is a package spec. It will not be zero in the case of 
  253.     * nested packages.
  254.     */
  255.     gen_ic(I_DATA, MAX_OFFSET-SFP_SIZE, "Local variables");/*GBSL*/
  256.     gen(I_END);
  257.  
  258.     tup = tup_new(3);
  259.     tup[1] = (char *) TASKS_DECLARED;
  260.     tup[2] = (char *) SPECS_DECLARED;
  261.     tup[3] = (char *) SUBPROG_SPECS; /* note 3rd comp was formerly signature*/
  262.     MISC(package_name)       = (char *) tup;
  263.     CODE_SEGMENT_MAP = segment_map_put(CODE_SEGMENT_MAP, CURRENT_CODE_SEGMENT,
  264.       CODE_SEGMENT);
  265. #ifdef MONITOR
  266.     *MON_PACKAGE_NAME = '\0';
  267. #endif
  268. }
  269.  
  270. void unit_package_body(Node body_node)                    /*;unit_package_body*/
  271. {
  272.     /*
  273.      * Compilation of a library package body.
  274.      * As it is a compilation unit, there is no task link to be preserved
  275.      */
  276.  
  277.     Node    id_node, decl_node, stmts_node, handler_node;
  278.     Symbol    package_name, package_proc, name, temp_name;
  279.     Tuple    tup, stub_tup;
  280.     int        si;
  281.     Segment    stemplate;
  282.     struct    tt_subprog *tptr;
  283.     int        i, n, stub_cs; 
  284.     unsigned int patch_addr;
  285.     Stubenv    ev;
  286.     Tuple    local_reference_map_new();
  287.  
  288. #ifdef TRACE
  289.     if (debug_flag)
  290.         gen_trace